;;;    lambda-tube (λ-tube) - A youtube search API and application in scheme.
;;;    Copyright (C) 2008  Abhishek Mishra
;;;
;;;    This program is free software: you can redistribute it and/or modify
;;;    it under the terms of the GNU General Public License as published by
;;;    the Free Software Foundation, either version 3 of the License, or
;;;    (at your option) any later version.

;;;    This program is distributed in the hope that it will be useful,
;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;    GNU General Public License for more details.

;;;    You should have received a copy of the GNU General Public License
;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; youtube search app main window
;;; author: Abhishek Mishra

(module lt-search-main-window mzscheme
  (require 
   (lib "mred.ss" "mred") 
   (lib "class.ss") 
   "lt-if.scm" 
   "lt-app-details.scm"
   "lt-about-dialog.scm"
   "lt-preferences.scm"
   "lt-scheduler.scm"
   "lt-tasks.scm"
   "lt-search-history.scm"
   "lt-i18n.scm"
   "lt-pref-dialog.scm"
   (lib "url.ss" "net")
   (lib "sendurl.ss" "net")
   (lib "process.ss")
   (lib "pregexp.ss"))
  (provide lt-search-frame 
           load-prefs 
           load-search-history-items)
  
  ;define lt-frame
  (define lt-frame%
    (class frame%
      
      ;augment and define on-close
      (augment on-close)
      (define (on-close)
        (if (not save-history?)
            (clear-history))
        (save-search-history))
      
      ;augment and define can-close?
      (augment can-close?)
      (define (can-close?)
        #t)
      
      (super-new)))
  
  ;declare the current query and feed objects
  (define current-query ())
  (define current-feed ())
  
  ;a function to create a new message% item with label and parent
  (define (create-message label parent width)
    (new message% [label label] [parent parent] [min-width width]))
  
  (define (create-multiline-message label parent width)
    (if (< (string-length label) width)
        (create-message label parent 200)
        (begin
          (create-message (substring label 0 width) parent 200) 
          (create-multiline-message (substring label width (string-length label)) parent width))))
  
  ;function to remove all children of container
  (define (remove-all-children area-container)
    (let ((children (send area-container  get-children)))
      (if (eq? children ())
          #f
          (begin
            (send area-container delete-child (car children))
            (remove-all-children area-container)))))
  
  ;function to remove all children of container by type
  (define (remove-all-hpanels parent children)
    (if (eq? children ())
        #f
        (begin
          (let ((ch (car children)))
            ;(write ch)
            (if (is-a? ch horizontal-panel%)
                (begin
                  (send parent delete-child ch))))
          (remove-all-hpanels parent (cdr children)))))
  
  ;This is the callback method for the search text-field
  (define (search-text-callback text-field event)
    (if (eq? (send event get-event-type) 'text-field-enter)
        (let ((search-string (send lt-search-text-field get-value)))
          (add-search-to-history search-string)
          (search-and-display 1))))
  
  ;This is the callback method for the search button
  (define (go-button-callback button event)
    (let ((search-string (send lt-search-text-field get-value)))
      (add-search-to-history search-string))
    (search-and-display 1))
  
  ;callback for the next button
  (define (next-button-callback button event)
    (let ((feed-start-index (string->number (send current-feed get-start-index)))
          (feed-items-per-page (string->number (send current-feed get-items-per-page))))
      (search-and-display (+ feed-start-index feed-items-per-page))
      ))
  
  ;callback for the previous button
  (define (previous-button-callback button event)
    (let ((feed-start-index (string->number (send current-feed get-start-index)))
          (feed-items-per-page (string->number (send current-feed get-items-per-page))))
      (search-and-display (- feed-start-index feed-items-per-page))
      ))
  
  
  ;Main frame
  (define lt-search-frame (new lt-frame% [label (app-label)] [min-width 640] [min-height 480]))
  
  ;About dialog
  (define about-dialog (get-about-dialog lt-search-frame))
  
  ;Preferences dialog
  ;(define pref-dialog (get-preferences-dialog lt-search-frame))
  
  ;Create top panel
  (define lt-panel (new vertical-panel% [parent lt-search-frame] [alignment '(center top)]))
  
  ;Create the search controls panel
  (define search-horizontal-panel (new horizontal-panel% 
                                       [parent lt-panel]
                                       [alignment '(center top)]
                                       [min-height 0]
                                       [stretchable-height #f]))
  
  ;Create search navigation panel
  (define lt-nav-panel (new horizontal-panel% 
                            [parent lt-panel]
                            [alignment '(center top)] 
                            [min-height 0] 
                            [stretchable-height #f]))
  
  ;search nav panel buttons and message
  (define nav-panel-message (create-message "" lt-nav-panel 400))
  (define nav-panel-previous-button (new button% 
                                         [parent lt-nav-panel] 
                                         [label (get-string "PREVIOUS_NAV_BUTTON_LABEL")] 
                                         [min-width 200] 
                                         [enabled #f]
                                         (callback previous-button-callback)))
  (define nav-panel-next-button (new button% 
                                     [parent lt-nav-panel] 
                                     [label (get-string "NEXT_NAV_BUTTON_LABEL")] 
                                     [min-width 200] 
                                     [enabled #f]
                                     (callback next-button-callback)))
  
  ;Search and download list horizontal panel
  (define lt-sad-panel (new horizontal-panel% 
                            [parent lt-panel]
                            [alignment '(center top)] 
                            [min-height 0] 
                            [stretchable-height #f]))
  
  ;Create search results panel
  (define lt-results-panel (new vertical-panel% 
                                [parent lt-sad-panel]
                                [alignment '(center top)]
                                [min-height 400]))
  
  ;Create downloads panel
  (define lt-downloads-panel (new vertical-panel% 
                                  [parent lt-sad-panel]
                                  [alignment '(center bottom)]
                                  [min-height 400]
                                  [min-width 300]
                                  [stretchable-width #f]
                                  [stretchable-height #f]
                                  [style '(border)]
                                  [border 1]))
  
  ;Download list label
  (create-message (get-string "DOWNLOAD_LIST_TITLE_LABEL") lt-downloads-panel 10)
  
  ;Create download list panel
  (define lt-dlist-panel (new vertical-panel% 
                              [parent lt-downloads-panel]
                              [alignment '(center top)]
                              [min-height 100]
                              [min-width 300]
                              [stretchable-width #f]
                              [style '(border)]
                              [border 1]))
  
  ;download list button panel
  (define lt-downloads-button-panel (new horizontal-panel% 
                                         [parent lt-downloads-panel]
                                         [alignment '(center top)] 
                                         [min-height 0] 
                                         [stretchable-height #f]))
  
  ;clear download list button
  (new button% 
       [parent lt-downloads-button-panel] 
       [label (get-string "CLEAR_COMPLETED_DOWNLOADS_BUTTON_LABEL")] 
       [min-width 100] 
       [min-height 5] 
       [enabled #t]
       (callback (lambda (button event)
                   (remove-all-hpanels lt-dlist-panel (send lt-dlist-panel get-children)))))
  
  ;open video folder button
  (new button% 
       [parent lt-downloads-button-panel] 
       [label (get-string "OPEN_VIDEO_FOLDER_BUTTON_LABEL")] 
       [min-width 100] 
       [min-height 5] 
       [enabled #t]
       (callback (lambda (button event)
                   (cond ((eq? (system-type) 'unix) (process (string-append "nautilus " video-folder)))
                         ((eq? (system-type) 'windows) (shell-execute #f video-folder "" (current-directory) 'sw_shownormal))
                         ))))
  
  
  (define lt-search-text-field (new combo-field% 
                                    [choices '()]
                                    [parent search-horizontal-panel] 
                                    [label (get-string "SEARCH_TEXT_FIELD_LABEL")]
                                    [callback search-text-callback]))
  (define lt-search-button (new button% 
                                [parent search-horizontal-panel] 
                                [label (get-string "START_SEARCH_BUTTON_LABEL")]
                                [min-width 200] 
                                (callback go-button-callback)))
  
  
  ;Create Search box and button in a horizontal panel
  (define (search-and-display start-index)
    (let ((search-string (send lt-search-text-field get-value)))
      (if (= (string-length search-string) 0)
          (send lt-search-frame set-status-text (get-string-by-language "NO_SEARCH_TEXT_STATUS_LABEL" (get-language-by-name "English(US)")))
          (begin (send lt-search-frame set-status-text (format (get-string-by-language "SEARCHING_STATUS_LABEL" (get-language-by-name "English(US)")) search-string))
                 (let* ((lt-query (new lt-query% [query-string search-string] [start-index start-index] [max-results (string->number resultspp)])) 
                        (lt-search-feed (send lt-query run-query))
                        (feed-start-index (send lt-search-feed get-start-index))
                        (feed-items-per-page (send lt-search-feed get-items-per-page))
                        (feed-total-results (send lt-search-feed get-total-results))
                        (numbers-message (format (get-string "SEARCH_RESULTS_STATUS_LABEL")
                                                 feed-start-index
                                                 (number->string (+ (string->number feed-items-per-page) (string->number feed-start-index) -1))
                                                 feed-total-results
                                                 ))
                        (numbers-message-english (format (get-string-by-language "SEARCH_RESULTS_STATUS_LABEL" (get-language-by-name "English(US)"))
                                                         feed-start-index
                                                         (number->string (+ (string->number feed-items-per-page) (string->number feed-start-index) -1))
                                                         feed-total-results
                                                         )))
                   ;set the current query and feed 
                   (set! current-query lt-query)
                   (set! current-feed lt-search-feed)
                   
                   ;disable/enable the previous button
                   (if (= (string->number feed-start-index) 1)
                       (send nav-panel-previous-button enable #f)
                       (send nav-panel-previous-button enable #t))
                   
                   ;disable/enable the next button
                   (if (>= (+ (string->number feed-start-index) (string->number feed-items-per-page)) (string->number feed-total-results))
                       (send nav-panel-next-button enable #f)
                       (send nav-panel-next-button enable #t))
                   
                   (remove-all-children lt-results-panel)
                   (send nav-panel-message set-label numbers-message)
                   (show-videos (reverse (send lt-search-feed get-videos)) 1)
                   (send lt-search-frame set-status-text (format (get-string-by-language "SEARCH_COMPLETE_STATUS_LABEL" (get-language-by-name "English(US)")) search-string numbers-message-english)))
                 ))))
  
  
  ;Make status-bar
  (send lt-search-frame create-status-line)
  ;(send lt-search-frame set-status-text (app-label))
  
  ;Main menu-bar
  (define lt-menu-bar (new menu-bar% [parent lt-search-frame]))
  
  ;Search Menu - with menu items New & Quit
  (define lt-search-menu (new menu% [label (get-string "SEARCH_MENU_LABEL")] [parent lt-menu-bar]))
  (define lt-search-new-menu-item (new menu-item% 
                                       [label (get-string "NEW_SEARCH_MENU_ITEM_LABEL")] 
                                       [parent lt-search-menu]
                                       (callback (lambda (button event)
                                                   (send nav-panel-previous-button enable #f)
                                                   (send nav-panel-next-button enable #f)
                                                   (remove-all-children lt-results-panel)
                                                   (send lt-search-text-field set-value "")
                                                   (send nav-panel-message set-label "")
                                                   (send lt-search-frame set-status-text (get-string-by-language "NEW_SEARCH_MENU_ITEM_STATUS_LABEL" (get-language-by-name "English(US)")))))))
  (define lt-search-pref-menu-item (new menu-item% 
                                        [label (get-string "PREFERENCES_MENU_ITEM_LABEL")] 
                                        [parent lt-search-menu]
                                        (callback (lambda (button event)
                                                    (send lt-search-frame set-status-text (get-string-by-language "PREFERENCES_MENU_ITEM_STATUS_LABEL" (get-language-by-name "English(US)")))
                                                    (send (get-preferences-dialog lt-search-frame) show #t)
                                                    (load-prefs)))))
  
  (define lt-search-quit-menu-item (new menu-item% 
                                        [label (get-string "QUIT_MENU_ITEM_LABEL")] 
                                        [parent lt-search-menu]
                                        (callback (lambda (button event)
                                                    (send lt-search-frame on-close)
                                                    (send lt-search-frame show #f)
                                                    (send lt-search-frame set-status-text (get-string-by-language "QUIT_MENU_ITEM_STATUS_LABEL" (get-language-by-name "English(US)")))))))
  
  ;Help Menu - with about menu-item
  (define lt-help-menu (new menu% [label (get-string "HELP_MENU_LABEL")] [parent lt-menu-bar]))
  (define lt-help-about-menu-item (new menu-item% 
                                       [label (get-string "ABOUT_MENU_ITEM_LABEL")] 
                                       [parent lt-help-menu]
                                       (callback (lambda (button event)
                                                   (send lt-search-frame set-status-text (get-string-by-language "ABOUT_MENU_ITEM_STATUS_LABEL" (get-language-by-name "English(US)")))
                                                   (send about-dialog show #t)))))
  
  
  ;utility method to cache the thumbnail as file on disk.
  (define (get-thumbnail-file image-url)
    (let* ((filename (path->string 
                      (build-path tncache-folder 
                                  (pregexp-replace* ":" 
                                                    (pregexp-replace* "/" image-url "%%%%") "%%%%")))))
      (if (file-exists? filename) 
          filename 
          (let ((file-port (open-output-file filename)))
            (pure-port->file-port (get-pure-port (string->url image-url)) file-port)
            filename))))
  
  (define (pure-port->file-port pure-port file-port)
    (let ((in (read-byte pure-port)))
      (if (eof-object? in) 
          (close-output-port file-port)
          (begin
            (write-byte in file-port)
            (pure-port->file-port pure-port file-port)))))
  
  
  ;shows the video results on the main panel
  (define (show-videos videos count)
    (thread (lambda () 
              (sleep 0)
              (let ((horiz-panel (new horizontal-panel% [parent lt-results-panel]
                                      [alignment '(left center)])))
                (if (eq? videos ()) 
                    #f
                    (let ((current-video (car videos)))
                      (send current-video set-format (get-format-value (get-format-by-name (send prefs get-param download-format-param))))
                      (create-message (number->string count) horiz-panel 10) 
                      (let* ((button-image-vpanel (new vertical-panel% 
                                                       [parent horiz-panel] 
                                                       [alignment '(left center)]))
                             (bitmap-vpanel (new vertical-panel% 
                                                 [parent button-image-vpanel] 
                                                 [alignment '(left center)])))
                             (if show-images? 
                                 (add-task-to-scheduler (new tn-download-task% 
                                                             [name (send current-video get-title)]
                                                             [delay 1]
                                                             [video current-video]
                                                             [bitmap-vpanel bitmap-vpanel])))
                             (let ((button-hpanel (new horizontal-panel% 
                                                       [parent button-image-vpanel] 
                                                       [alignment '(left center)])))
                               (new button% 
                                    [parent button-hpanel] 
                                    [label (get-string "BROWSE_BUTTON_LABEL")] 
                                    [min-width 55] 
                                    [enabled #t]
                                    (callback (lambda (button event)
                                                (send-url (send current-video get-url)))))
                               (let ((download-button (get-download-button current-video button-hpanel)))
                                 (if (send current-video video-downloaded? video-folder)
                                     (send download-button set-label (get-string "PLAY_BUTTON_LABEL"))
                                     (send download-button enable #t)))))
                        (new text-field% 
                             [label ""] 
                             [parent horiz-panel] 
                             [init-value (get-video-details-text current-video)] 
                             [style '(multiple)]
                             [min-width 300]) 
                        ;[min-width 300])
                        (show-videos (cdr videos) (+ count 1))
                        ))))))
    
    ;; get the download button
    (define (get-download-button current-video button-hpanel)
      (new button% 
           [parent button-hpanel] 
           [label (get-string "DOWNLOAD_BUTTON_LABEL")] 
           [min-width 55] 
           [enabled #t]
           (callback (lambda (button event)
                       (if (string=? (send button get-label) (get-string "PLAY_BUTTON_LABEL"))
                           (begin
                             (play-video (path->string (send current-video get-download-path video-folder))))
                           (begin
                             (send button set-label (get-string "DOWNLOADING_BUTTON_LABEL"))
                             (send button enable #f)
                             (let* ((dgauge (add-download current-video)) 
                                    (update-proc (lambda (got-bytes total-bytes filename error-message)
                                                   (if (eq? error-message #f)
                                                       (let ((completion-percentage (inexact->exact (floor (* 100.00 (/ got-bytes total-bytes))))))
                                                         (if (= completion-percentage 100)
                                                             (begin
                                                               (send button set-label (get-string "PLAY_BUTTON_LABEL"))
                                                               (send button enable #t)
                                                               (completed-download current-video dgauge filename)
                                                               (if play-video-on-download?
                                                                   (play-video (path->string (send current-video get-download-path video-folder)))))
                                                             (send dgauge set-value completion-percentage)))
                                                       (begin
                                                         (let ((err-msg (format (get-string-by-language error-message (get-language-by-name "English(US)"))
                                                                                (send current-video get-title))))
                                                           (send button set-label (get-string "DOWNLOAD_BUTTON_LABEL"))
                                                           (send button enable #t)
                                                           (download-error current-video dgauge err-msg)
                                                           (show-error-message err-msg))
                                                         (send dgauge set-value 100))))))
                               (add-task-to-scheduler (new download-task% 
                                                           [name (send current-video get-title)]
                                                           [delay 1]
                                                           [video current-video]
                                                           [download-folder video-folder]
                                                           [format (get-format-value (get-format-by-name (send prefs get-param download-format-param)))]
                                                           [update-procedure update-proc])))))))))
    
    ;; get video details
    (define (get-video-details-text current-video)
      (string-append
       (send current-video get-title)
       "\n====================\n"
       (format (get-string "AUTHOR_LABEL") (send current-video get-author-name))
       "\n"
       (format (get-string "RATING_LABEL") 
               (let ((r (send current-video get-avg-rating)))
                 (if (eq? r #f) "-" (number->string r))))
       "\n"
       (format (get-string "DURATION_LABEL") 
               (let* ((d (send current-video get-duration))
                      (m (quotient d 60))
                      (s (remainder d 60)))
                 (format (get-string "DURATION_STRING") m s)))
       "\n====================\n\n"
       (if show-comments?
           (send current-video get-content)
           "")))
    
    ;adds a download to the download list
    (define (add-download video)
      (let* ((l (let ((s (send video get-title)))
                  (if (< 25 (string-length s))
                      (substring s 0 25)
                      s))) 
             (dg (new gauge% 
                      [label l]
                      [range 100]
                      [parent lt-dlist-panel]
                      [min-width 200]
                      [stretchable-width #f])))
        dg
        ))
    
    ;called when download is completed
    (define (completed-download video g filename)
      (send lt-dlist-panel delete-child g)
      (let ((horiz-panel (new horizontal-panel% 
                              [parent lt-dlist-panel]
                              [alignment '(left center)]
                              [min-height 5]
                              [stretchable-height #f])))
        (new button% 
             [parent horiz-panel] 
             [label "Play>"] 
             [min-width 2] 
             [enabled #t]
             (callback (lambda (button event)
                         (play-video (path->string filename)))))
        (let ((l (let ((s (send video get-title)))
                   (if (< 25 (string-length s))
                       (substring s 0 25)
                       s)))) 
          (create-message l horiz-panel 10))))
    
    ;called when there is an error downloading
    (define (download-error video g message)
      (send lt-dlist-panel delete-child g)
      (let ((horiz-panel (new horizontal-panel% 
                              [parent lt-dlist-panel]
                              [alignment '(left center)]
                              [min-height 5]
                              [stretchable-height #f])))
        (let ((l (if (< 45 (string-length message))
                     (substring message 0 45)
                     message))) 
          (create-message l horiz-panel 10))))
    
    ;play the video
    (define (play-video video-name)
      (let ((process-command (string-append "\""(send prefs get-param media-player-param)"\"" " \"" video-name "\"")))
        (process process-command)))
    
    ;loads search history in the search input box
    (define (load-search-history-items)
      (let ((search-history (get-search-history)))
        (letrec ((add-search-items (lambda (hist)
                                     (if (eq? hist '())
                                         #f
                                         (begin
                                           (send lt-search-text-field append (car hist))
                                           (add-search-items (cdr hist)))))))
          (add-search-items search-history))))
    
    (define (add-search-to-history text)
      (if (add-search-item-to-history text)
          (send lt-search-text-field append text)))
    
    ;Displays an error message. (In a message box and the status bar.)
    (define (show-error-message message)
      (send lt-search-frame set-status-text message)
      (message-box (get-string "ERROR_MESSAGE_DIALOG_TITLE") message lt-search-frame '(ok)))
    
    ; A Thumbnail download task
    (define tn-download-task%
      (class generic-task%
        
        (init-field video)
        
        (init-field bitmap-vpanel)
        
        (augment execute)
        (define (execute)
          (let ((thumbnail-file (get-thumbnail-file (send video get-thumbnail))))
            (create-message (make-object bitmap% thumbnail-file) bitmap-vpanel 100))
          (inner (void) execute))
        
        (super-new)
        ))
    )
  